home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pastutor.EXE / tutor03c.pas < prev    next >
Pascal/Delphi Source File  |  1998-04-02  |  4KB  |  121 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Tutor03c;
  9.  
  10. uses TutConst, Drivers, Objects, Views, Menus, App, MsgBox;
  11.  
  12. type
  13.   TTutorApp = object(TApplication)
  14.     constructor Init;
  15.     procedure DoAboutBox;
  16.     procedure HandleEvent(var Event: TEvent); virtual;
  17.     procedure InitMenuBar; virtual;
  18.     procedure InitStatusLine; virtual;
  19.   end;
  20.  
  21. constructor TTutorApp.Init;
  22. begin
  23.   inherited Init;
  24.   DisableCommands([cmOrderWin, cmStockWin, cmSupplierWin]);
  25. end;
  26.  
  27. procedure TTutorApp.DoAboutBox;
  28. begin
  29.   MessageBox(#3'Turbo Vision Tutorial Application'#13 +
  30.     #3'Copyright 1992'#13#3'Borland International',
  31.     nil, mfInformation or mfOKButton);
  32. end;
  33.  
  34. procedure TTutorApp.HandleEvent(var Event: TEvent);
  35. var
  36.   R: TRect;
  37. begin
  38.   inherited HandleEvent(Event);
  39.   if Event.What = evCommand then
  40.   begin
  41.     case Event.Command of
  42.       cmOptionsVideo:
  43.         begin
  44.           SetScreenMode(ScreenMode xor smFont8x8);
  45.           ClearEvent(Event);
  46.         end;
  47.       cmAbout:
  48.         begin
  49.           DoAboutBox;
  50.           ClearEvent(Event);
  51.         end;
  52.     end;
  53.   end;
  54. end;
  55.  
  56. procedure TTutorApp.InitMenuBar;
  57. var
  58.   R: TRect;
  59. begin
  60.   GetExtent(R);
  61.   R.B.Y := R.A.Y + 1;
  62.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  63.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  64.       StdFileMenuItems(nil)),
  65.     NewSubMenu('~E~dit', hcNoContext, NewMenu(
  66.       StdEditMenuItems(
  67.       NewLine(
  68.       NewItem('~S~how clipboard', '', kbNoKey, cmClipShow, hcNoContext,
  69.       nil)))),
  70.     NewSubMenu('~O~rders', hcNoContext, NewMenu(
  71.       NewItem('~N~ew', 'F9', kbF9, cmOrderNew, hcNoContext,
  72.       NewItem('~S~ave', '', kbNoKey, cmOrderSave, hcNoContext,
  73.       NewLine(
  74.       NewItem('Next', 'PgDn', kbPgDn, cmOrderNext, hcNoContext,
  75.       NewItem('Prev', 'PgUp', kbPgUp, cmOrderPrev, hcNoContext,
  76.       nil)))))),
  77.     NewSubMenu('O~p~tions', hcNoContext, NewMenu(
  78.       NewItem('~T~oggle video', '', kbNoKey, cmOptionsVideo, hcNoContext,
  79.       NewItem('~S~ave desktop', '', kbNoKey, cmOptionsSave, hcNoContext,
  80.       NewItem('~L~oad desktop', '', kbNoKey, cmOptionsLoad, hcNoContext,
  81.       nil)))),
  82.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  83.       NewItem('Orders', '', kbNoKey, cmOrderWin, hcNoContext,
  84.       NewItem('Stock items', '', kbNoKey, cmStockWin, hcNoContext,
  85.       NewItem('Suppliers', '', kbNoKey, cmSupplierWin, hcNoContext,
  86.       NewLine(
  87.       StdWindowMenuItems(nil)))))),
  88.     NewSubMenu('~H~elp', hcNoContext, NewMenu(
  89.       NewItem('~A~bout...', '', kbNoKey, cmAbout, hcNoContext,
  90.       nil)),
  91.     nil))))))
  92.   )));
  93. end;
  94.  
  95. procedure TTutorApp.InitStatusLine;
  96. var
  97.   R: TRect;
  98. begin
  99.   GetExtent(R);
  100.   R.A.Y := R.B.Y - 1;
  101.   New(StatusLine, Init(R,
  102.     NewStatusDef(0, $EFFF,
  103.       NewStatusKey('~F3~ Open', kbF3, cmOpen,
  104.       NewStatusKey('~F4~ New', kbF4, cmNew,
  105.       NewStatusKey('~Alt+F3~ Close', kbAltF3, cmClose,
  106.       StdStatusKeys(nil)))),
  107.     NewStatusDef($F000, $FFFF,
  108.       NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
  109.       NewStatusKey('~Shift+F6~ Prev', kbShiftF6, cmOrderPrev,
  110.       StdStatusKeys(nil))), nil))));
  111. end;
  112.  
  113. var
  114.   TutorApp: TTutorApp;
  115.  
  116. begin
  117.   TutorApp.Init;
  118.   TutorApp.Run;
  119.   TutorApp.Done;
  120. end.
  121.